Option Compare Database
Option Explicit


Const LWA_COLORKEY = 1
Const LWA_ALPHA = 2
Const LWA_BOTH = 3
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = -20


Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
                        ByVal hWnd As Long, _
                        ByVal nIndex As Long) _
                        As Long
                        
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
                        ByVal hWnd As Long, _
                        ByVal nIndex As Long, _
                        ByVal dwNewLong As Long) _
                        As Long

Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
                        ByVal hWnd As Long, _
                        ByVal color As Long, _
                        ByVal bAlpha As Byte, _
                        ByVal alpha As Long) _
                        As Boolean


Public Sub Translucent(hWnd As Long, opacity As Integer)
On Error GoTo ErrorRtn

   Dim attrib As Long

   'put current GWL_EXSTYLE in attrib
   attrib = GetWindowLong(hWnd, GWL_EXSTYLE)

   'change GWL_EXSTYLE to WS_EX_LAYERED - makes a window layered
   SetWindowLong hWnd, GWL_EXSTYLE, attrib Or WS_EX_LAYERED

   'Make transparent (RGB value does not have any effect at this
   'time, will in Part 2 of this article)
   SetLayeredWindowAttributes hWnd, RGB(0, 0, 0), opacity, _
                                       LWA_ALPHA
   Exit Sub

ErrorRtn:
    MsgBox err.Description & " Source : " & err.Source

End Sub



Public Sub fadeIn(uiForm As Form)
'// loop counter
Dim I As Integer
    
    For I = 255 To 0 Step -1
        Call Translucent(uiForm.hWnd, I)
        DoEvents
    Next I
    '// close object
    DoCmd.Close acForm, uiForm.Name
End Sub


Public Sub fadeOut(uiForm As Form, Optional opacity As Integer = 255)
'// loop counter
Dim I As Integer
    
    For I = 1 To opacity
        Call Translucent(uiForm.hWnd, I)
        DoEvents
    Next I

End Sub



